home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / ctax / ctax-parse.y < prev    next >
Encoding:
Text File  |  1995-08-14  |  28.2 KB  |  1,206 lines
  1. /*    Copyright (C) 1994 Free Software Foundation, Inc.
  2.  
  3. This program is free software; you can redistribute it and/or modify
  4. it under the terms of the GNU General Public License as published by
  5. the Free Software Foundation; either version 2, or (at your option)
  6. any later version.
  7.  
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. GNU General Public License for more details.
  12.  
  13. You should have received a copy of the GNU General Public License
  14. along with this software; see the file COPYING.  If not, write to
  15. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  16.  
  17. /*
  18.  * Tom Lord
  19.  * Cygnus Support
  20.  */
  21.  
  22. %{
  23. #include "ctax.h"
  24. extern int parse_line_no;
  25. extern YYSTYPE parse_answer;
  26.  
  27. extern YYSTYPE parse_cons ();
  28. extern YYSTYPE parse_2list ();
  29. extern YYSTYPE parse_append ();
  30. extern YYSTYPE parse_append_optcons ();
  31. extern YYSTYPE parse_eol;
  32. extern YYSTYPE parse_false;
  33. extern YYSTYPE parse_define_sym;
  34. extern YYSTYPE parse_SCM_sym;
  35. extern YYSTYPE parse_if_sym;
  36. extern YYSTYPE parse_while_sym;
  37. extern YYSTYPE parse_for_sym;
  38. extern YYSTYPE parse_return_sym;
  39. extern YYSTYPE parse_break_sym;
  40. extern YYSTYPE parse_continue_sym;
  41. extern YYSTYPE parse_comma_sym;
  42. extern YYSTYPE parse_begin_sym;
  43. extern YYSTYPE parse_do_sym;
  44. extern YYSTYPE parse_scheme_val_sym;
  45. extern YYSTYPE parse_scheme_kw_sym;
  46. extern YYSTYPE parse_neg_sym;
  47. extern YYSTYPE parse_log_neg_sym;
  48. extern YYSTYPE parse_pos_sym;
  49. extern YYSTYPE parse_bit_neg_sym;
  50. extern YYSTYPE parse_bit_and_sym;
  51. extern YYSTYPE parse_times_sym;
  52. extern YYSTYPE parse_div_sym;
  53. extern YYSTYPE parse_mod_sym;
  54. extern YYSTYPE parse_plus_sym;
  55. extern YYSTYPE parse_minus_sym;
  56. extern YYSTYPE parse_lshift_sym;
  57. extern YYSTYPE parse_rshift_sym;
  58. extern YYSTYPE parse_eq_sym;
  59. extern YYSTYPE parse_ne_sym;
  60. extern YYSTYPE parse_le_sym;
  61. extern YYSTYPE parse_ge_sym;
  62. extern YYSTYPE parse_lt_sym;
  63. extern YYSTYPE parse_gt_sym;
  64. extern YYSTYPE parse_bit_and_sym;
  65. extern YYSTYPE parse_bit_xor_sym;
  66. extern YYSTYPE parse_bit_or_sym;
  67. extern YYSTYPE parse_log_and_sym;
  68. extern YYSTYPE parse_log_or_sym;
  69. extern YYSTYPE parse_assign_sym;
  70. extern YYSTYPE parse_aref_sym;
  71. extern YYSTYPE parse_if_exp_sym;
  72. extern YYSTYPE parse_apply_sym;
  73. extern YYSTYPE parse_lambda_sym;
  74. extern YYSTYPE parse_list_sym;
  75. extern YYSTYPE parse_array_sym;
  76. extern YYSTYPE parse_bit_array_sym;
  77. extern YYSTYPE parse_uint_array_sym;
  78. extern YYSTYPE parse_int_array_sym;
  79. extern YYSTYPE parse_float_array_sym;
  80. extern YYSTYPE parse_double_array_sym;
  81. extern YYSTYPE parse_complex_array_sym;
  82. extern YYSTYPE parse_struct_sym;
  83. extern YYSTYPE parse_struct_type_sym;
  84. extern YYSTYPE parse_make_struct_sym;
  85. extern YYSTYPE parse_field_ref_sym;
  86. extern YYSTYPE parse_field_ref_col_sym;
  87. extern YYSTYPE parse_aref_col_sym;
  88. extern YYSTYPE parse_assign_col_sym;
  89. extern YYSTYPE parse_times_col_sym;
  90. extern YYSTYPE parse_mod_col_sym;
  91. extern YYSTYPE parse_plus_col_sym;
  92. extern YYSTYPE parse_minus_col_sym;
  93. extern YYSTYPE parse_lshift_col_sym;
  94. extern YYSTYPE parse_rshift_col_sym;
  95. extern YYSTYPE parse_eq_col_sym;
  96. extern YYSTYPE parse_ne_col_sym;
  97. extern YYSTYPE parse_le_col_sym;
  98. extern YYSTYPE parse_ge_col_sym;
  99. extern YYSTYPE parse_lt_col_sym;
  100. extern YYSTYPE parse_gt_col_sym;
  101. extern YYSTYPE parse_bit_and_col_sym;
  102. extern YYSTYPE parse_bit_or_col_sym;
  103. extern YYSTYPE parse_log_and_col_sym;
  104. extern YYSTYPE parse_log_or_col_sym;
  105. extern YYSTYPE parse_bit_neg_col_sym;
  106. extern YYSTYPE parse_log_neg_col_sym;
  107. %}
  108.  
  109. %right '?' ':'
  110. %left ','
  111. %left '='
  112. %left ctax_or_lx
  113. %left ctax_and_lx
  114. %left '|'
  115. %left '^'
  116. %left '&'
  117. %left ctax_eq_lx ctax_ne_lx
  118. %left '<' '>' ctax_le_lx ctax_ge_lx
  119. %left ctax_lshift_lx ctax_rshift_lx
  120. %left '+' '-'
  121. %left '*' '/' '%'
  122. %right UNARY
  123.  
  124. %token ctax_number_lx
  125. %token ctax_id_lx
  126. %token ctax_SCM_lx
  127. %token ctax_if_lx
  128. %token ctax_else_lx
  129. %token ctax_for_lx
  130. %token ctax_while_lx
  131. %token ctax_return_lx
  132. %token ctax_do_lx
  133. %token ctax_break_lx
  134. %token ctax_continue_lx
  135. %token ctax_interactive_lx
  136. %token ctax_string_lx
  137. %token ctax_char_lx
  138. %token ctax_bit_array_lx
  139. %token ctax_uint_array_lx
  140. %token ctax_int_array_lx
  141. %token ctax_float_array_lx
  142. %token ctax_double_array_lx
  143. %token ctax_complex_array_lx
  144. %token ctax_struct_lx
  145. %token ctax_field_ref_lx
  146. %token ctax_new_lx
  147. %token ctax_field_ref_col_lx
  148. %token ctax_field_ref_col_lx
  149. %token ctax_subs_left_col_lx
  150. %token ctax_subs_right_col_lx
  151. %token ctax_assign_col_lx
  152. %token ctax_add_col_lx
  153. %token ctax_subtract_col_lx
  154. %token ctax_multiply_col_lx
  155. %token ctax_divide_col_lx
  156. %token ctax_bitand_col_lx
  157. %token ctax_bitor_col_lx
  158. %token ctax_bitnot_col_lx
  159. %token ctax_lognot_col_lx
  160. %token ctax_bitxor_col_lx
  161. %token ctax_modulo_col_lx
  162. %token ctax_less_col_lx
  163. %token ctax_greater_col_lx
  164. %token ctax_eq_col_lx
  165. %token ctax_ne_col_lx
  166. %token ctax_ge_col_lx
  167. %token ctax_le_col_lx
  168. %token ctax_lshift_col_lx
  169. %token ctax_rshift_col_lx
  170. %token ctax_and_col_lx
  171. %token ctax_or_col_lx
  172.  
  173.  
  174.  
  175. %%
  176. command:        definition
  177.                        { parse_answer = $1; YYACCEPT; }
  178.             | statement
  179.                        { parse_answer = $1; YYACCEPT; }
  180.             ;
  181.  
  182. definition:        ctax_SCM_lx ctax_id_lx '=' initializer ';'
  183.                      {
  184.                        $$ = 
  185.                        parse_cons
  186.                      (parse_SCM_sym,
  187.                       parse_2list
  188.                       (parse_cons ($2, parse_eol), $4));
  189.                      }
  190.  
  191.             | ctax_struct_lx ctax_id_lx opt_superclass '{' field_list '}' ';'
  192.                      {
  193.                        $$ =
  194.                      parse_cons (parse_SCM_sym,
  195.                              parse_2list
  196.                              (parse_cons ($2, parse_eol)),
  197.                              (parse_cons
  198.                               (parse_struct_sym,
  199.                                (parse_cons ($2,
  200.                                     parse_2list ($5, $3))))));
  201.                      }
  202.  
  203.             | ctax_SCM_lx symbol_list ';'
  204.                      {
  205.                        $$ = 
  206.                        parse_cons
  207.                      (parse_SCM_sym,
  208.                       parse_2list
  209.                       ($2, parse_number ("0")));
  210.                      }
  211.             
  212.  
  213.             | ctax_SCM_lx ctax_id_lx definition_form
  214.                      {
  215.                        $$ =
  216.                        parse_cons
  217.                        (parse_define_sym,
  218.                         parse_cons
  219.                         ($2, $3));
  220.                      }
  221.             ;
  222.  
  223. symbol_list:        ctax_id_lx
  224.                      { $$ = parse_cons ($1, parse_eol); }
  225.             | symbol_list ',' ctax_id_lx
  226.                      { $$ = parse_append ($1, $3); }
  227.             ;
  228.  
  229. initializer:        expression
  230.                          { $$ = $1; }
  231.             ;
  232.  
  233.  
  234. opt_superclass:        ':' ctax_id_lx
  235.                      { $$ = $2; }
  236.             |
  237.                      { $$ = parse_false; }
  238.  
  239. field_list:        ctax_id_lx ';'
  240.                      { $$ = parse_cons ($1, parse_eol); }
  241.             | ctax_SCM_lx ctax_id_lx ';'
  242.                      { $$ = parse_cons ($2, parse_eol); }
  243.             | field_list ctax_id_lx ';'
  244.                      { $$ = parse_append ($1, $3); }
  245.             | field_list ctax_SCM_lx ctax_id_lx ';'
  246.                      { $$ = parse_append ($1, $4); }
  247.             |
  248.                      { $$ = parse_eol; }
  249.             ;
  250.  
  251. definition_form:    '(' parameter_list ')' opt_doc opt_interaction body
  252.                      {
  253.                        $$ =
  254.                      parse_cons
  255.                        ($2,
  256.                         parse_cons
  257.                         ($4, parse_2list ($5, $6)));
  258.                      }
  259.             ;
  260.  
  261. parameter_list:        ctax_id_lx
  262.                      { $$ = parse_cons ($1, parse_eol); }
  263.             | ctax_SCM_lx ctax_id_lx
  264.                      { $$ = parse_cons ($2, parse_eol); }
  265.             | parameter_list ',' ctax_id_lx
  266.                      { $$ = parse_append ($1, $3); }
  267.             | parameter_list ',' ctax_SCM_lx ctax_id_lx
  268.                      { $$ = parse_append ($1, $4); }
  269.             |
  270.                      { $$ = parse_eol; }
  271.             ;
  272.  
  273. opt_doc:        ctax_string_lx
  274.                      { $$ = $1; }
  275.             |
  276.                      { $$ = parse_false; }
  277.             ;
  278.  
  279. opt_interaction:    ctax_interactive_lx expression
  280.                      { $$ = $2; }
  281.             |
  282.                      { $$ = parse_false; }
  283.             ;
  284.  
  285. body:            '{' local_definition_list statement_list '}'
  286.                      {
  287.                        $$
  288.                        = parse_cons
  289.                          (parse_begin_sym,
  290.                       parse_cons ($2, $3));
  291.                       }
  292.             ;
  293.  
  294. local_definition_list:    definition
  295.                      { $$ = parse_cons ($1, parse_eol); }
  296.             | local_definition_list definition
  297.                      { $$ = parse_append ($1, $2); }
  298.             |
  299.                      { $$ = parse_eol; }
  300.             ;
  301.  
  302. statement_list:        statement
  303.                      { $$ = parse_cons ($1, parse_eol); }
  304.             | statement_list statement
  305.                      { $$ = parse_append ($1, $2); }
  306.             ;
  307.  
  308. statement:        expression ';'
  309.                      { $$ = $1; }
  310.             | ctax_if_lx '(' expression ')' statement opt_else
  311.                      {
  312.                        $$
  313.                        = parse_cons (parse_if_sym,
  314.                              parse_cons
  315.                              ($3,
  316.                               parse_2list ($5, $6)));
  317.                       }
  318.             | ctax_while_lx '(' expression ')' statement
  319.                      {
  320.                        $$
  321.                        = parse_cons (parse_while_sym,
  322.                              parse_2list ($3, $5));
  323.                       }
  324.             | ctax_for_lx '(' exp1 ';' exp1 ';' exp1  ')'
  325.                 statement
  326.                      {
  327.                        $$
  328.                        = parse_cons
  329.                          (parse_for_sym,
  330.                       parse_cons
  331.                       ($3,
  332.                        parse_cons ($5,
  333.                                parse_2list ($7, $9))));
  334.                       }
  335.             | ctax_do_lx
  336.                  statement
  337.               ctax_while_lx '(' expression ')' ';'
  338.                      {
  339.                        $$
  340.                        = parse_cons (parse_do_sym,
  341.                              parse_2list ($5, $2));
  342.                       }
  343.             | '{' local_definition_list statement_list '}'
  344.                      {
  345.                        $$
  346.                        = parse_cons
  347.                          (parse_begin_sym,
  348.                       parse_cons ($2, $3));
  349.                       }
  350.             | ctax_return_lx opt_expression ';'
  351.                      {
  352.                        $$
  353.                        = parse_2list (parse_return_sym, $2);
  354.                       }
  355.             | ctax_break_lx ';'
  356.                      { $$ = parse_break_sym; }
  357.  
  358.             | ctax_continue_lx ';'
  359.                      { $$ = parse_continue_sym; }
  360.             ;
  361.  
  362. opt_expression:        expression
  363.                      { $$ = $1; }
  364.             |
  365.                      { $$ = parse_false; }
  366.             ;
  367.  
  368. opt_else:        ctax_else_lx statement
  369.                      { $$ = $2; }
  370.             |
  371.                      { $$ = parse_false; }
  372.             ;
  373.  
  374.  
  375. expression:        exp1
  376.                { $$ = $1; }
  377.  
  378. exp1    :    exp
  379.                { $$ = $1; }
  380.     |    exp1 ',' exp
  381.                {
  382.                  $$ = parse_cons (parse_comma_sym,
  383.                           parse_2list ($1, $3));
  384.                }
  385.     ;
  386.  
  387. /* Expressions, not including the comma operator.  */
  388. exp    :    '-' exp    %prec UNARY
  389.                {
  390.                  $$ = parse_2list (parse_neg_sym, $2);
  391.                }
  392.     |    '!' exp    %prec UNARY
  393.                {
  394.                  $$ = parse_2list (parse_log_neg_sym, $2);
  395.                }
  396.     |    ctax_lognot_col_lx exp    %prec UNARY
  397.                {
  398.                  $$ = parse_2list (parse_log_neg_col_sym, $2);
  399.                }
  400.     |    '~' exp    %prec UNARY
  401.                {
  402.                  $$ = parse_2list (parse_bit_neg_sym, $2);
  403.                }
  404.     |    ctax_bitnot_col_lx exp    %prec UNARY
  405.                {
  406.                  $$ = parse_2list (parse_bit_neg_col_sym, $2);
  407.                }
  408.     |    '(' exp1 ')'
  409.                {
  410.                  $$ = $2;
  411.                }
  412.     |    exp '(' arg_list ')'
  413.                { $$ = parse_cons (parse_apply_sym,
  414.                            parse_2list ($1, $3)); }
  415.  
  416.     |     '@' '(' arg_list ')'
  417.                { $$ = parse_cons (parse_apply_sym,
  418.                            parse_2list (parse_list_sym, $3)); }
  419.     |     '@' '[' arg_list ']'
  420.                { $$ = parse_cons (parse_apply_sym,
  421.                            parse_2list (parse_array_sym, $3)); }
  422.  
  423.     |     ctax_bit_array_lx '[' arg_list ']'
  424.                { $$ = parse_cons (parse_apply_sym,
  425.                            parse_2list (parse_bit_array_sym, $3)); }
  426.  
  427.     |     ctax_uint_array_lx '[' arg_list ']'
  428.                { $$ = parse_cons (parse_apply_sym,
  429.                            parse_2list (parse_uint_array_sym, $3)); }
  430.  
  431.     |     ctax_int_array_lx '[' arg_list ']'
  432.                { $$ = parse_cons (parse_apply_sym,
  433.                            parse_2list (parse_int_array_sym, $3)); }
  434.  
  435.     |     ctax_float_array_lx '[' arg_list ']'
  436.                { $$ = parse_cons (parse_apply_sym,
  437.                            parse_2list (parse_float_array_sym, $3)); }
  438.  
  439.     |     ctax_double_array_lx '[' arg_list ']'
  440.                { $$ = parse_cons (parse_apply_sym,
  441.                            parse_2list (parse_double_array_sym, $3)); }
  442.  
  443.     |     ctax_complex_array_lx '[' arg_list ']'
  444.                { $$ = parse_cons (parse_apply_sym,
  445.                            parse_2list (parse_complex_array_sym, $3)); }
  446.  
  447.  
  448.  
  449.     |       '@' '\\' definition_form
  450.                { $$ = parse_cons (parse_lambda_sym, $3); }
  451.  
  452.     | ctax_new_lx ctax_struct_lx ctax_id_lx opt_params
  453.                    {
  454.                  $$ = parse_cons (parse_make_struct_sym,
  455.                           parse_cons ($3, $4));
  456.                }
  457.     | '(' ctax_struct_lx ctax_id_lx ')' '{' arg_list '}' 
  458.                    {
  459.                  $$ = parse_cons (parse_make_struct_sym,
  460.                           parse_cons ($3, $6));
  461.                }
  462.     | '(' ctax_struct_lx ctax_id_lx ')' 
  463.                    {
  464.                  $$ = parse_2list (parse_struct_type_sym, $3);
  465.                }
  466.     | '(' ctax_struct_lx ctax_id_lx opt_superclass '{' field_list '}' ')'
  467.                    {
  468.                  $$ = parse_cons (parse_struct_sym,
  469.                           (parse_cons ($2,
  470.                                parse_2list ($5, $3))));
  471.                }
  472.  
  473.  
  474.  
  475.     ;
  476.  
  477. opt_params:    '(' arg_list ')'
  478.                {
  479.                  $$ = $2;
  480.                }
  481.         |
  482.                {
  483.                  $$ = parse_eol;
  484.                }
  485.  
  486. /* Binary operators in order of decreasing precedence.  */
  487. exp    :    exp ctax_field_ref_lx ctax_id_lx
  488.                {
  489.                  $$ =
  490.                  parse_cons (parse_field_ref_sym,
  491.                       parse_2list ($1, $3));
  492.                }
  493.     |    exp ctax_field_ref_col_lx ctax_id_lx
  494.                {
  495.                  $$ =
  496.                  parse_cons (parse_field_ref_col_sym,
  497.                       parse_2list ($1, $3));
  498.                }
  499.     |    exp '[' exp ']'
  500.                {
  501.                  $$ =
  502.                  parse_cons (parse_aref_sym,
  503.                       parse_2list ($1, $3));
  504.                }
  505.     |    exp ctax_subs_left_col_lx exp ctax_subs_right_col_lx
  506.                {
  507.                  $$ =
  508.                  parse_cons (parse_aref_col_sym,
  509.                       parse_2list ($1, $3));
  510.                }
  511.     |       exp '=' exp
  512.                {
  513.                  $$ =
  514.                  parse_cons (parse_assign_sym,
  515.                       parse_2list ($1, $3));
  516.                }
  517.     |       exp ctax_assign_col_lx exp
  518.                {
  519.                  $$ =
  520.                  parse_cons (parse_assign_col_sym,
  521.                       parse_2list ($1, $3));
  522.                }
  523.     |    exp '*' exp
  524.                {
  525.                  $$ =
  526.                  parse_cons (parse_times_sym,
  527.                       parse_2list ($1, $3));
  528.                }
  529.     |    exp ctax_multiply_col_lx exp
  530.                {
  531.                  $$ =
  532.                  parse_cons (parse_times_col_sym,
  533.                       parse_2list ($1, $3));
  534.                }
  535.     |    exp '/' exp
  536.                {
  537.                  $$ =
  538.                  parse_cons (parse_div_sym,
  539.                       parse_2list ($1, $3));
  540.                }
  541.     |    exp ctax_divide_col_lx exp
  542.                {
  543.                  $$ =
  544.                  parse_cons (parse_div_sym,
  545.                       parse_2list ($1, $3));
  546.                }
  547.     |    exp '%' exp
  548.                {
  549.                  $$ =
  550.                  parse_cons (parse_mod_sym,
  551.                       parse_2list ($1, $3));
  552.                }
  553.     |    exp ctax_modulo_col_lx exp
  554.                {
  555.                  $$ =
  556.                  parse_cons (parse_mod_col_sym,
  557.                       parse_2list ($1, $3));
  558.                }
  559.     |    exp '+' exp
  560.                {
  561.                  $$ =
  562.                  parse_cons (parse_plus_sym,
  563.                       parse_2list ($1, $3));
  564.                }
  565.     |    exp ctax_add_col_lx exp
  566.                {
  567.                  $$ =
  568.                  parse_cons (parse_plus_col_sym,
  569.                       parse_2list ($1, $3));
  570.                }
  571.     |    exp '-' exp
  572.                {
  573.                  $$ =
  574.                  parse_cons (parse_minus_sym,
  575.                       parse_2list ($1, $3));
  576.                }
  577.     |    exp ctax_subtract_col_lx exp
  578.                {
  579.                  $$ =
  580.                  parse_cons (parse_minus_col_sym,
  581.                       parse_2list ($1, $3));
  582.                }
  583.     |    exp ctax_lshift_lx exp
  584.                {
  585.                  $$ =
  586.                  parse_cons (parse_lshift_sym,
  587.                       parse_2list ($1, $3));
  588.                }
  589.     |    exp ctax_lshift_col_lx exp
  590.                {
  591.                  $$ =
  592.                  parse_cons (parse_lshift_col_sym,
  593.                       parse_2list ($1, $3));
  594.                }
  595.     |    exp ctax_rshift_lx exp
  596.                {
  597.                  $$ =
  598.                  parse_cons (parse_rshift_sym,
  599.                       parse_2list ($1, $3));
  600.                }
  601.     |    exp ctax_rshift_col_lx exp
  602.                {
  603.                  $$ =
  604.                  parse_cons (parse_rshift_col_sym,
  605.                       parse_2list ($1, $3));
  606.                }
  607.     |    exp ctax_eq_lx exp
  608.                {
  609.                  $$ =
  610.                  parse_cons (parse_eq_sym,
  611.                       parse_2list ($1, $3));
  612.                }
  613.     |    exp ctax_eq_col_lx exp
  614.                {
  615.                  $$ =
  616.                  parse_cons (parse_eq_col_sym,
  617.                       parse_2list ($1, $3));
  618.                }
  619.     |    exp ctax_ne_lx exp
  620.                {
  621.                  $$ =
  622.                  parse_cons (parse_ne_sym,
  623.                       parse_2list ($1, $3));
  624.                }
  625.     |    exp ctax_ne_col_lx exp
  626.                {
  627.                  $$ =
  628.                  parse_cons (parse_ne_col_sym,
  629.                       parse_2list ($1, $3));
  630.                }
  631.     |    exp ctax_le_lx exp
  632.                {
  633.                  $$ =
  634.                  parse_cons (parse_le_sym,
  635.                       parse_2list ($1, $3));
  636.                }
  637.     |    exp ctax_le_col_lx exp
  638.                {
  639.                  $$ =
  640.                  parse_cons (parse_le_col_sym,
  641.                       parse_2list ($1, $3));
  642.                }
  643.     |    exp ctax_ge_lx exp
  644.                {
  645.                  $$ =
  646.                  parse_cons (parse_ge_sym,
  647.                       parse_2list ($1, $3));
  648.                }
  649.     |    exp ctax_ge_col_lx exp
  650.                {
  651.                  $$ =
  652.                  parse_cons (parse_ge_col_sym,
  653.                       parse_2list ($1, $3));
  654.                }
  655.     |    exp '<' exp
  656.                {
  657.                  $$ =
  658.                  parse_cons (parse_lt_sym,
  659.                       parse_2list ($1, $3));
  660.                }
  661.     |    exp ctax_less_col_lx exp
  662.                {
  663.                  $$ =
  664.                  parse_cons (parse_lt_col_sym,
  665.                       parse_2list ($1, $3));
  666.                }
  667.     |    exp '>' exp
  668.                {
  669.                  $$ =
  670.                  parse_cons (parse_gt_sym,
  671.                       parse_2list ($1, $3));
  672.                }
  673.     |    exp ctax_greater_col_lx exp
  674.                {
  675.                  $$ =
  676.                  parse_cons (parse_gt_col_sym,
  677.                       parse_2list ($1, $3));
  678.                }
  679.     |    exp '&' exp
  680.                {
  681.                  $$ =
  682.                  parse_cons (parse_bit_and_sym,
  683.                       parse_2list ($1, $3));
  684.                }
  685.     |    exp ctax_bitand_col_lx exp
  686.                {
  687.                  $$ =
  688.                  parse_cons (parse_bit_and_col_sym,
  689.                       parse_2list ($1, $3));
  690.                }
  691.     |    exp '^' exp
  692.                {
  693.                  $$ =
  694.                  parse_cons (parse_bit_xor_sym,
  695.                       parse_2list ($1, $3));
  696.                }
  697.     |    exp ctax_bitxor_col_lx exp
  698.                {
  699.                  $$ =
  700.                  parse_cons (parse_bit_xor_sym,
  701.                       parse_2list ($1, $3));
  702.                }
  703.     |    exp '|' exp
  704.                {
  705.                  $$ =
  706.                  parse_cons (parse_bit_or_sym,
  707.                       parse_2list ($1, $3));
  708.                }
  709.     |    exp ctax_bitor_col_lx exp
  710.                {
  711.                  $$ =
  712.                  parse_cons (parse_bit_or_col_sym,
  713.                       parse_2list ($1, $3));
  714.                }
  715.     |    exp ctax_and_lx exp
  716.                {
  717.                  $$ =
  718.                  parse_cons (parse_log_and_sym,
  719.                       parse_2list ($1, $3));
  720.                }
  721.     |    exp ctax_and_col_lx exp
  722.                {
  723.                  $$ =
  724.                  parse_cons (parse_log_and_col_sym,
  725.                       parse_2list ($1, $3));
  726.                }
  727.     |    exp ctax_or_lx exp
  728.                {
  729.                  $$ =
  730.                  parse_cons (parse_log_or_sym,
  731.                       parse_2list ($1, $3));
  732.                }
  733.     |    exp ctax_or_col_lx exp
  734.                {
  735.                  $$ =
  736.                  parse_cons (parse_log_or_col_sym,
  737.                       parse_2list ($1, $3));
  738.                }
  739.     |    exp '?' exp ':' exp
  740.                {
  741.                  $$ =
  742.                  parse_cons (parse_if_exp_sym,
  743.                       parse_cons ($1, 
  744.                                parse_2list ($3,$5)));
  745.                }
  746.     |    ctax_number_lx
  747.                { $$ = $1; }
  748.     |    ctax_char_lx
  749.                { $$ = $1; }
  750.     |    ctax_string_lx
  751.                { $$ = $1; }
  752.     |    ctax_id_lx
  753.                { $$ = $1; }
  754.  
  755.     |    '@' ':' ctax_id_lx
  756.                { $$ = parse_2list (parse_scheme_kw_sym, $3); }
  757.     |    '@' ctax_string_lx
  758.                { $$ = parse_2list (parse_scheme_val_sym, $2); }
  759.     ;
  760.  
  761. arg_list:    exp
  762.                 { $$ = parse_cons ($1, parse_eol); }
  763.     |    arg_list ',' exp
  764.             { $$ = parse_append ($1, $3); }
  765.     |
  766.             { $$ = parse_eol; }
  767.  
  768.  
  769. %%
  770.  
  771. int parse_line_no;
  772. YYSTYPE parse_answer;
  773. YYSTYPE parse_eol;
  774. YYSTYPE parse_false;
  775. YYSTYPE parse_define_sym;
  776. YYSTYPE parse_SCM_sym;
  777. YYSTYPE parse_if_sym;
  778. YYSTYPE parse_while_sym;
  779. YYSTYPE parse_for_sym;
  780. YYSTYPE parse_return_sym;
  781. YYSTYPE parse_break_sym;
  782. YYSTYPE parse_continue_sym;
  783. YYSTYPE parse_comma_sym;
  784. YYSTYPE parse_do_sym;
  785. YYSTYPE parse_scheme_val_sym;
  786. YYSTYPE parse_scheme_kw_sym;
  787. YYSTYPE parse_begin_sym;
  788. YYSTYPE parse_neg_sym;
  789. YYSTYPE parse_log_neg_sym;
  790. YYSTYPE parse_pos_sym;
  791. YYSTYPE parse_bit_neg_sym;
  792. YYSTYPE parse_bit_and_sym;
  793. YYSTYPE parse_times_sym;
  794. YYSTYPE parse_div_sym;
  795. YYSTYPE parse_mod_sym;
  796. YYSTYPE parse_plus_sym;
  797. YYSTYPE parse_minus_sym;
  798. YYSTYPE parse_lshift_sym;
  799. YYSTYPE parse_rshift_sym;
  800. YYSTYPE parse_eq_sym;
  801. YYSTYPE parse_ne_sym;
  802. YYSTYPE parse_le_sym;
  803. YYSTYPE parse_ge_sym;
  804. YYSTYPE parse_lt_sym;
  805. YYSTYPE parse_gt_sym;
  806. YYSTYPE parse_bit_and_sym;
  807. YYSTYPE parse_bit_xor_sym;
  808. YYSTYPE parse_bit_or_sym;
  809. YYSTYPE parse_log_and_sym;
  810. YYSTYPE parse_log_or_sym;
  811. YYSTYPE parse_if_exp_sym;
  812. YYSTYPE parse_apply_sym;
  813. YYSTYPE parse_lambda_sym;
  814. YYSTYPE parse_list_sym;
  815. YYSTYPE parse_array_sym;
  816. YYSTYPE parse_bit_array_sym;
  817. YYSTYPE parse_uint_array_sym;
  818. YYSTYPE parse_int_array_sym;
  819. YYSTYPE parse_float_array_sym;
  820. YYSTYPE parse_double_array_sym;
  821. YYSTYPE parse_complex_array_sym;
  822. YYSTYPE parse_struct_sym;
  823. YYSTYPE parse_struct_type_sym;
  824. YYSTYPE parse_make_struct_sym;
  825. YYSTYPE parse_field_ref_sym;
  826. YYSTYPE parse_assign_sym;
  827. YYSTYPE parse_aref_sym;
  828. YYSTYPE parse_field_ref_col_sym;
  829. YYSTYPE parse_aref_col_sym;
  830. YYSTYPE parse_assign_col_sym;
  831. YYSTYPE parse_times_col_sym;
  832. YYSTYPE parse_mod_col_sym;
  833. YYSTYPE parse_plus_col_sym;
  834. YYSTYPE parse_minus_col_sym;
  835. YYSTYPE parse_lshift_col_sym;
  836. YYSTYPE parse_rshift_col_sym;
  837. YYSTYPE parse_eq_col_sym;
  838. YYSTYPE parse_ne_col_sym;
  839. YYSTYPE parse_le_col_sym;
  840. YYSTYPE parse_ge_col_sym;
  841. YYSTYPE parse_lt_col_sym;
  842. YYSTYPE parse_gt_col_sym;
  843. YYSTYPE parse_bit_and_col_sym;
  844. YYSTYPE parse_bit_or_col_sym;
  845. YYSTYPE parse_log_and_col_sym;
  846. YYSTYPE parse_log_or_col_sym;
  847. YYSTYPE parse_bit_neg_col_sym;
  848. YYSTYPE parse_log_neg_col_sym;
  849.  
  850. YYSTYPE parse_root;
  851.  
  852.  
  853. void
  854. parse_protect (a)
  855.      YYSTYPE a;
  856. {
  857.   SCM protector;
  858.   NEWCELL(protector);
  859.   CAR(protector) = a;
  860.   CDR(protector) = parse_root;
  861.   parse_root = protector;
  862. }
  863.  
  864. YYSTYPE
  865. parse_intern (s)
  866.      char * s;
  867. {
  868.   SCM answer;
  869.   int len;
  870.   len = strlen (s);
  871.   {
  872.     int x;
  873.     for (x = 0; x < len; ++x)
  874.       switch (s[x])
  875.     {
  876.     default:
  877.       break;
  878.     case '_':
  879.       s[x] = '-';
  880.     }
  881.   }
  882.   answer = scm_intern (s, strlen(s));
  883.   if (CDR(answer) == SCM_UNDEFINED)
  884.     CDR (answer) = MAKINUM(0);
  885.   parse_protect (answer);
  886.   return CAR(answer);
  887. }
  888.  
  889.  
  890. YYSTYPE
  891. parse_make_string (s)
  892.      char * s;
  893. {
  894.   SCM answer;
  895.   char * out;
  896.   char * in;
  897.   in = s + 1;
  898.   out = s;
  899.  interpret_char:
  900.   switch (*in)
  901.     {
  902.     default:
  903.       *out = *in;
  904.       ++out;
  905.       ++in;
  906.       goto interpret_char;
  907.     case '"':
  908.       break;
  909.     case '\\':
  910.       ++in;
  911.       switch (*in)
  912.     {
  913.     default:
  914.       *out = *in;
  915.       ++out;
  916.       ++in;
  917.       goto interpret_char;
  918.     case 'n':
  919.       *out = '\n';
  920.       ++out;
  921.       ++in;
  922.       goto interpret_char;
  923.     case 'r':
  924.       *out = '\r';
  925.       ++out;
  926.       ++in;
  927.       goto interpret_char;
  928.     case 't':
  929.       *out = '\t';
  930.       ++out;
  931.       ++in;
  932.       goto interpret_char;
  933.     case '0':
  934.       {
  935.         int x;
  936.         int len;
  937.         ++in;
  938.         len = 1;
  939.         x = 0;
  940.         while (('0' < *in) && ('8' > *in) && (len < 4))
  941.           {
  942.         x *= 8;
  943.         x += (*in - '0');
  944.         ++in;
  945.           }
  946.         *out = x;
  947.         ++out;
  948.         ++in;
  949.         goto interpret_char;
  950.       }
  951.     }
  952.     }
  953.   *out = 0;
  954.   {
  955.     int len;
  956.     len = strlen (s);
  957.     answer = scm_makstr (len, 0);
  958.     memcpy (CHARS(answer), s, len);
  959.   }
  960.   parse_protect (answer);
  961.   return answer;
  962. }
  963.  
  964. YYSTYPE
  965. parse_make_char (s)
  966.      char * s;
  967. {
  968.   int c;
  969.   char * in;
  970.   in = s + 1;
  971.   switch (*in)
  972.     {
  973.     default:
  974.       c = *in;
  975.       break;
  976.     case '\\':
  977.       ++in;
  978.       switch (*in)
  979.     {
  980.     default:
  981.       c = *in;
  982.       break;
  983.     case 'n':
  984.       c = '\n';
  985.       break;
  986.     case 'r':
  987.       c = '\r';
  988.       break;
  989.     case 't':
  990.       c = '\t';
  991.       break;
  992.     case '0':
  993.       {
  994.         int x;
  995.         int len;
  996.         ++in;
  997.         len = 1;
  998.         x = 0;
  999.         while (('0' < *in) && ('8' > *in) && (len < 4))
  1000.           {
  1001.         x *= 8;
  1002.         x += (*in - '0');
  1003.         ++in;
  1004.           }
  1005.         c = x;
  1006.         break;
  1007.       }
  1008.     }
  1009.     }
  1010.  
  1011.   return MAKICHR (c);
  1012. }
  1013.  
  1014.  
  1015. YYSTYPE 
  1016. parse_cons (a, b)
  1017.      YYSTYPE a;
  1018.      YYSTYPE b;
  1019. {
  1020.   SCM answer;
  1021.   NEWCELL(answer);
  1022.   CAR(answer) = a;
  1023.   CDR(answer) = b;
  1024.   parse_protect (answer);
  1025.   return answer;
  1026. }
  1027.  
  1028. YYSTYPE 
  1029. parse_append (l, p)
  1030.      YYSTYPE l;
  1031.      YYSTYPE p;
  1032. {
  1033.   SCM newc;
  1034.   SCM orig;
  1035.   newc = parse_cons (p, parse_eol);
  1036.  
  1037.   if (l == EOL)
  1038.     return newc;
  1039.  
  1040.   orig = l;
  1041.   while (NIMP(l) && NIMP (CDR(l)))
  1042.     l = CDR(l);
  1043.  
  1044.   if (NIMP(l))
  1045.     CDR(l) = newc;
  1046.  
  1047.   return orig;
  1048. }
  1049.  
  1050. YYSTYPE 
  1051. parse_append_optcons (l, p)
  1052.      YYSTYPE l;
  1053.      YYSTYPE p;
  1054. {
  1055.   if (NIMP (p))
  1056.     return parse_append (l, p);
  1057.   else
  1058.     {
  1059.       SCM last;
  1060.       NEWCELL (last);
  1061.       CAR(last) = p;
  1062.       CDR(last) = parse_eol;
  1063.       return parse_append (l, last);
  1064.     }  
  1065. }
  1066.  
  1067.  
  1068. YYSTYPE 
  1069. parse_2list (l, p)
  1070.      YYSTYPE l;
  1071.      YYSTYPE p;
  1072. {
  1073.   SCM newc;
  1074.   NEWCELL (newc);
  1075.   CAR(newc) = p;
  1076.   CDR(newc) = EOL;
  1077.   return parse_cons (l, newc);
  1078. }
  1079.  
  1080. YYSTYPE
  1081. parse_number (t)
  1082.      char * t;
  1083. {
  1084.   return scm_istring2number (t, strlen (t), 10);
  1085. }
  1086.  
  1087. SCM ctax_burst_fn;
  1088. static char * parse_buffer;
  1089. static char * parse_buffer_pos;
  1090.  
  1091. int
  1092. parse_input (buf, max_size)
  1093.      char * buf;
  1094.      int max_size;
  1095. {
  1096.   SCM str;
  1097.   int result;
  1098.   str = scm_apply (ctax_burst_fn, EOL, EOL);
  1099.   if (NIMP(str) && STRINGP(str))
  1100.     {
  1101.       memcpy (buf, CHARS(str), LENGTH(str));
  1102.       return LENGTH(str);
  1103.     }
  1104.   else
  1105.     return 0;
  1106. }
  1107.  
  1108. #ifdef __STDC__
  1109. void
  1110. scm_init_ctax_parser (void)
  1111. #else
  1112. void
  1113. scm_init_ctax_parser ()
  1114. #endif
  1115. {
  1116.   parse_eol = EOL;
  1117.   parse_false = BOOL_F;
  1118.  
  1119.   parse_root = scm_sysintern ("ctax:parse-root", EOL);
  1120.   parse_SCM_sym = CAR(scm_sysintern ("ctax:SCM", MAKINUM(0)));
  1121.   parse_define_sym = CAR(scm_sysintern ("ctax:define", MAKINUM(0)));
  1122.   parse_if_sym = CAR(scm_sysintern ("ctax:if", MAKINUM(0)));
  1123.   parse_while_sym = CAR(scm_sysintern ("ctax:while", MAKINUM(0)));
  1124.   parse_for_sym = CAR(scm_sysintern ("ctax:for", MAKINUM(0)));
  1125.   parse_return_sym = CAR(scm_sysintern ("ctax:return", MAKINUM(0)));
  1126.   parse_break_sym = CAR(scm_sysintern ("ctax:break", MAKINUM(0)));
  1127.   parse_continue_sym = CAR(scm_sysintern ("ctax:continue", MAKINUM(0)));
  1128.   parse_comma_sym = CAR(scm_sysintern ("ctax:comma", MAKINUM(0)));
  1129.   parse_do_sym = CAR(scm_sysintern ("ctax:do", MAKINUM(0)));
  1130.   parse_scheme_val_sym = CAR(scm_sysintern ("ctax:scheme-val", MAKINUM(0)));
  1131.   parse_scheme_kw_sym = CAR(scm_sysintern ("ctax:scheme-kw", MAKINUM(0)));
  1132.   parse_begin_sym = CAR(scm_sysintern ("ctax:begin", MAKINUM(0)));
  1133.   parse_neg_sym = CAR(scm_sysintern ("ctax:neg", MAKINUM(0)));
  1134.   parse_log_neg_sym = CAR(scm_sysintern ("ctax:log-neg", MAKINUM(0)));
  1135.   parse_pos_sym = CAR(scm_sysintern ("ctax:pos", MAKINUM(0)));
  1136.   parse_bit_neg_sym = CAR(scm_sysintern ("ctax:bit-neg", MAKINUM(0)));
  1137.   parse_bit_and_sym = CAR(scm_sysintern ("ctax:bit-and", MAKINUM(0)));
  1138.   parse_times_sym = CAR(scm_sysintern ("ctax:times", MAKINUM(0)));
  1139.   parse_div_sym = CAR(scm_sysintern ("ctax:div", MAKINUM(0)));
  1140.   parse_mod_sym = CAR(scm_sysintern ("ctax:mod", MAKINUM(0)));
  1141.   parse_plus_sym = CAR(scm_sysintern ("ctax:plus", MAKINUM(0)));
  1142.   parse_minus_sym = CAR(scm_sysintern ("ctax:minus", MAKINUM(0)));
  1143.   parse_lshift_sym = CAR(scm_sysintern ("ctax:lshift", MAKINUM(0)));
  1144.   parse_rshift_sym = CAR(scm_sysintern ("ctax:rshift", MAKINUM(0)));
  1145.   parse_eq_sym = CAR(scm_sysintern ("ctax:eq", MAKINUM(0)));
  1146.   parse_ne_sym = CAR(scm_sysintern ("ctax:ne", MAKINUM(0)));
  1147.   parse_le_sym = CAR(scm_sysintern ("ctax:le", MAKINUM(0)));
  1148.   parse_ge_sym = CAR(scm_sysintern ("ctax:ge", MAKINUM(0)));
  1149.   parse_lt_sym = CAR(scm_sysintern ("ctax:lt", MAKINUM(0)));
  1150.   parse_gt_sym = CAR(scm_sysintern ("ctax:gt", MAKINUM(0)));
  1151.   parse_bit_and_sym = CAR(scm_sysintern ("ctax:bit-and", MAKINUM(0)));
  1152.   parse_bit_xor_sym = CAR(scm_sysintern ("ctax:bit-xor", MAKINUM(0)));
  1153.   parse_bit_or_sym = CAR(scm_sysintern ("ctax:bit-or", MAKINUM(0)));
  1154.   parse_log_and_sym = CAR(scm_sysintern ("ctax:log-and", MAKINUM(0)));
  1155.   parse_log_or_sym = CAR(scm_sysintern ("ctax:log-or", MAKINUM(0)));
  1156.   parse_if_exp_sym = CAR(scm_sysintern ("ctax:if-exp", MAKINUM(0)));
  1157.   parse_apply_sym = CAR(scm_sysintern ("ctax:apply", MAKINUM(0)));
  1158.   parse_lambda_sym = CAR(scm_sysintern ("ctax:lambda", MAKINUM(0)));
  1159.   parse_list_sym = CAR(scm_sysintern ("ctax:list", MAKINUM(0)));
  1160.   parse_array_sym = CAR(scm_sysintern ("ctax:array", MAKINUM(0)));
  1161.   parse_bit_array_sym = CAR(scm_sysintern ("ctax:bit-array", MAKINUM(0)));
  1162.   parse_uint_array_sym = CAR(scm_sysintern ("ctax:uint-array", MAKINUM(0)));
  1163.   parse_int_array_sym = CAR(scm_sysintern ("ctax:int-array", MAKINUM(0)));
  1164.   parse_float_array_sym = CAR(scm_sysintern ("ctax:float-array", MAKINUM(0)));
  1165.   parse_double_array_sym = CAR(scm_sysintern ("ctax:double-array", MAKINUM(0)));
  1166.   parse_complex_array_sym = CAR(scm_sysintern ("ctax:complex-array", MAKINUM(0)));
  1167.   parse_field_ref_sym = CAR(scm_sysintern ("ctax:->", MAKINUM(0)));
  1168.   parse_struct_sym = CAR(scm_sysintern ("ctax:struct", MAKINUM(0)));
  1169.   parse_struct_type_sym = CAR(scm_sysintern ("ctax:struct-type", MAKINUM(0)));
  1170.   parse_make_struct_sym = CAR(scm_sysintern ("ctax:make-struct", MAKINUM(0)));
  1171.   parse_assign_sym = CAR(scm_sysintern ("ctax:assign", MAKINUM(0)));
  1172.   parse_aref_sym = CAR(scm_sysintern ("ctax:aref", MAKINUM(0)));
  1173.   parse_field_ref_col_sym = CAR (scm_sysintern ("ctax:parse_field_ref_col_sym", MAKINUM (0)));
  1174.   parse_aref_col_sym = CAR (scm_sysintern ("ctax:[]:", MAKINUM (0)));
  1175.   parse_assign_col_sym = CAR (scm_sysintern ("ctax:=:", MAKINUM (0)));
  1176.   parse_times_col_sym = CAR (scm_sysintern ("ctax:*:", MAKINUM (0)));
  1177.   parse_mod_col_sym = CAR (scm_sysintern ("ctax:%:", MAKINUM (0)));
  1178.   parse_plus_col_sym = CAR (scm_sysintern ("ctax:+:", MAKINUM (0)));
  1179.   parse_minus_col_sym = CAR (scm_sysintern ("ctax:-:", MAKINUM (0)));
  1180.   parse_lshift_col_sym = CAR (scm_sysintern ("ctax:<<:", MAKINUM (0)));
  1181.   parse_rshift_col_sym = CAR (scm_sysintern ("ctax:>>:", MAKINUM (0)));
  1182.   parse_eq_col_sym = CAR (scm_sysintern ("ctax:==:", MAKINUM (0)));
  1183.   parse_ne_col_sym = CAR (scm_sysintern ("ctax:!=:", MAKINUM (0)));
  1184.   parse_le_col_sym = CAR (scm_sysintern ("ctax:<=:", MAKINUM (0)));
  1185.   parse_ge_col_sym = CAR (scm_sysintern ("ctax:>=:", MAKINUM (0)));
  1186.   parse_lt_col_sym = CAR (scm_sysintern ("ctax:<:", MAKINUM (0)));
  1187.   parse_gt_col_sym = CAR (scm_sysintern ("ctax:>:", MAKINUM (0)));
  1188.   parse_bit_and_col_sym = CAR (scm_sysintern ("ctax:&:", MAKINUM (0)));
  1189.   parse_bit_or_col_sym = CAR (scm_sysintern ("ctax:|:", MAKINUM (0)));
  1190.   parse_log_and_col_sym = CAR (scm_sysintern ("ctax:&&:", MAKINUM (0)));
  1191.   parse_log_or_col_sym = CAR (scm_sysintern ("ctax:||:", MAKINUM (0)));
  1192.   parse_bit_neg_col_sym = CAR (scm_sysintern ("ctax:~:" , MAKINUM (0)));
  1193.   parse_log_neg_col_sym = CAR (scm_sysintern ("ctax:!:" , MAKINUM (0)));
  1194. }
  1195.  
  1196. int
  1197. ctyywrap ()
  1198. {
  1199.   return 1;
  1200. }
  1201.  
  1202. yywrap()
  1203. {
  1204.   return 0; 
  1205. }
  1206.